(* ===================================================================== *)
(** MESSAGE : module integrant, interface utilisateur verbose
    Gestion des messages d'erreur, des warnings.
    TODO : traduire en anglais, en turque ? 
    @author Mathieu Barbin, Ocan SANKUR
    @version samedi 17 novembre 2007 *)
(* ===================================================================== *)

open Bplib

(** le numero de version du framework "This is ... version ..." *)
let version = "1.0.1"

(** Obtenir la date *)
let tm () = Unix.localtime (Unix.time ());;

let get_date () =
  let d2 n = let d = n / 10 and u = n mod 10 in Printf.sprintf "%d%d" d u
  and t = Unix.localtime (Unix.time ()) in
  Printf.sprintf "%s:%s:%s, le %s/%s/%s" (d2 t.Unix.tm_hour) (d2 t.Unix.tm_min) (d2 t.Unix.tm_sec) (d2 t.Unix.tm_mday) (d2 (t.Unix.tm_mon + 1)) (d2 (t.Unix.tm_year mod 100));;

(* ===================================================================== *)
(** Classe message : contient tous les messages destinés au stderr *)
(* ===================================================================== *)
class c_message =
object(this)

  val mutable verbose = false
  val mutable net_list = "Net-list"

  method set_net_list s = net_list <- s
  method get_net_list = net_list

  val mutable bpi_file = "Bpi-file"
  method set_bpi_file s = bpi_file <- s
  method get_bpi_file = bpi_file

  val mutable bpo_file = "Bpo-file"
  method set_bpo_file s = bpo_file <- s
  method get_bpo_file = bpo_file  

  method get_verbose = verbose

  method verbose_actif = verbose <- true
  method verbose_desactif = verbose <- false

  method private print_all s = Printf.fprintf stderr "%s" s; flush stderr

  method private print s =
    if verbose 
    then (Printf.fprintf stderr "%s" s; flush stderr)
    else ()
 
  method private warning = this#print_all "[!] : "
 
  method private error = (this#verbose_actif; this#print "Erreur : ")

  method private quit:unit = 
    begin
      this#print_all "XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX\n";
      this#print_all "--> Abandon de l'execution.\n\n";
      exit 1
    end

  method private print_line =
    this#print   "===============================================\n"

  method private print_line_all =
    this#print_all   "===============================================\n"

  (* simulation *)

  method thisis s = 
    begin
      Printf.fprintf stderr "This is %s @bebopframework, version %s\n" s version;
      flush stderr
    end
      
  method compatibilites =
    begin
      this#print "Verification des compatibilites entrees-sorties.\n"
    end

  method top_level module_name file =
    begin
      this#print_all (Printf.sprintf " --> Main Module \"%s\" : file = \"%s\".\n" module_name file); 
    end

  method axiome axiome_name =
    begin
      this#print_all (Printf.sprintf " Simulation : <\"%s\">\n" axiome_name)
    end

  method including_file file =
    begin
      this#print_all (Printf.sprintf " --> #include : file = \"%s\".\n" file)
    end

  method including_module module_name =
    begin
      this#print_all (Printf.sprintf " --> #include : module = \"%s\".\n" module_name)
    end

  method not_found_bebop_dir =
    begin
      this#error;
      this#print_all "La variable BEBOPDIR doit pointee sur le repertoire d'installation de bebop\n";
      this#quit
    end
      
  method divergence_in_out input_e trait_e trait_s circ_e circ_s =
    let p t = Array.iter (fun s -> Printf.fprintf stderr "%s " s) t in
    begin
      this#error;
      Printf.fprintf stderr "Conflit dans les entrees-sorties\n\n";
      Printf.fprintf stderr "Entrees de l'input_file : ";
      p input_e;
      Printf.fprintf stderr "\nEntrees du traitement   : ";
      p trait_e;
      Printf.fprintf stderr "\nSorties du traitement   : ";
      p trait_s;
      Printf.fprintf stderr "\nEntrees du circuit      : ";
      p circ_e;
      Printf.fprintf stderr "\nSorties du circuit      : ";
      p circ_s;
      Printf.fprintf stderr "\n";
      flush stderr;
      this#quit
    end
    
  method init_simulation =
    begin
      this#print "Initialisation de la simulation.\n"
    end

  method init_process index name arite_min =
    begin
      let s = Printf.sprintf "Initialisation du processus %d = \"%s\" : pipe01 [ >= %d ].\n" index name arite_min in
      this#print s
    end

  method close_process index name si code =
    begin
      let s = Printf.sprintf "Fermeture du processus %d = \"%s\". (status : %s %d)\n" index name si code in
      this#print s
    end

  method close_process_error index name si code =
    begin
      let s = Printf.sprintf "Fermeture du processus %d = \"%s\". (status : %s %d)\n" index name si code in
      this#print s
    end

  method bloc_externe_indefini file line name =
    begin
      this#error;
      Printf.fprintf stderr "Module \"%s\", ligne %d : bloc external \"%s\" inconnu\n" file line name;
      this#quit;
    end 

  method method_non_definie methode =
    begin
      let m = Printf.sprintf "Attention : Methode %s non definie (reproduite telle quelle).\n" methode 
      in this#print_all m
    end 

  method pipe_arite_sortie_error command index question reponse arite_min len_sortie = 
    begin
      this#error;
      Printf.fprintf stderr "BLOC EXTERNE - PROTOCOLE %d (\"%s\") ERROR\n" index command;
      Printf.fprintf stderr "\"%s\" recoit : \"%s\"\n" command question;
      Printf.fprintf stderr "\"%s\" repond : \"%s\"\n" command reponse;
      Printf.fprintf stderr "Arite minimale attendue en reponse : %d (ici %d)\n" arite_min len_sortie;
      this#quit;
    end

  method protocole_sortie_error command index question reponse = 
    begin
      this#error;
      Printf.fprintf stderr "BLOC EXTERNE - PROTOCOLE %d (\"%s\") ERROR\n" index command;
      Printf.fprintf stderr "\"%s\" recoit : \"%s\"\n" command question;
      Printf.fprintf stderr "\"%s\" repond : \"%s\" : ECHEC PROTOCOLE '0-1'\n" command reponse;
      this#quit;
    end

  method input_arite_error donnee len_donnee arite_attendue =
    begin
      this#error;
      Printf.fprintf stderr "STDIN INPUT - PROTOCOLE 01 ERROR\n";
      Printf.fprintf stderr "stdin : \"%s\" (%d), arite attendue : %d\n" donnee len_donnee arite_attendue;
      this#quit;
    end

  method pipe_imbrique_arite_probleme file ligne nom =
    begin
      this#error;
      Printf.fprintf stderr "Module \"%s\", ligne %d : pipe(\"%s\"...)\n" file ligne nom;
      Printf.fprintf stderr "Bebop refuse d'inférer l'arité sortante d'une application externe dans un appel imbriqué.\n";
      Printf.fprintf stderr "Utiliser la syntaxe pipe[expr_arith](\"my_exe\"...)\n";
      this#quit;
    end

  method external_imbrique_arite_probleme file ligne nom =
    begin
      this#error;
      Printf.fprintf stderr "Module \"%s\", ligne %d : $%s...(...)\n" file ligne nom;
      Printf.fprintf stderr "Bebop refuse d'inférer l'arité sortante d'une application externe dans un appel imbriqué.\n";
      Printf.fprintf stderr "Utiliser la syntaxe $bloc.method[expr_arith](\"my_exe\"...)\n";
      this#quit;
    end

  method pipe_error command index question = 
    begin
      this#error;
      Printf.fprintf stderr "BLOC EXTERNE - PROTOCOLE %d (%s) ERROR\n" index command;
      Printf.fprintf stderr "\"%s\" processus recoit : %s et termine anormalement\n" command question;
      this#quit;
    end

  method autre_langage bopipe lg =
   begin
	this#error;
	Printf.fprintf stderr "Le langage \"%s\" n'est pas implémenté pour %s %s...\n" lg bopipe version;
	Printf.fprintf stderr "S'il vous manque, vous pouvez contribuer au projet bebopframework.\n";
	this#quit;
   end

  method langage_inconnu bopipe lg =
   begin
	this#error;
	Printf.fprintf stderr "#source = \"%s\" : n'est pas un langage reconnu par %s %s.\n" lg bopipe version;
	this#quit;
   end

  method bloc_extern_for_compilation prg modul line fct = 
    begin
      this#error;
      Printf.fprintf stderr " Module %s - Ligne %d - appel \"%s\" \n [!] : blocs externes (pipe) non supportes par la compilation-%s\n" modul line fct prg; 
      this#quit;
    end 

  method double_utilisation_ident_bop2vlog ident = 
    begin
      this#error;
      Printf.fprintf stderr " Ident \"%s\" : \n [!] La double utilisation (vecteur - signal) n'est supportee par bop2vlog\n" ident; 
      this#quit;
    end 

  method bebop_task_system_ignored modul line chaine = 
    begin
      this#print_all
	(Printf.sprintf "[>] Module %s - Ligne %d - appel systeme \"%s\" ignore\n" modul line chaine)
    end 


  method error_indexation_bop2 file line var pgr = 
    begin
      this#error;
      Printf.fprintf stderr " %s : Ligne %d - signal \"%s\" : \n ce type d'indexation n'est pas supportee par cette version de %s\n" file line var pgr; 
      this#quit;
    end    

  method init_lecture_seq = ()
  (*  begin
      this#print "Preparation de la lecture des entrees (input_file).\n"
    end  *)

  method lecture_entree_text e =
    begin
      let s = Printf.sprintf "Lecture de l'entree %s (text) : " e in
      this#print s
    end  

  method lecture_entree_file e f =
    begin
      let s = Printf.sprintf "Lecture de l'entree %s (\"%s\") : " e f in
      this#print s
    end  
      
  method nombre_entrees_lues n =
    if n <= 0 
    then
      begin
	this#print "Entree Vide\n";
	this#error;
	this#print "Une entree doit comporter au moins 1 bit.\n";
	this#quit;
      end
    else
      begin
	let s = Printf.sprintf "%d valeurs d'entrees\n" n in
	this#print s
      end   

  method lancement_simulation c_op =
    begin
      this#print_line_all;
      match c_op with
        | None ->
            let s = Printf.sprintf
              "Lancement de la simulation en boucle (nombre de cycles non precises par l'utilisateur).\n" in
            this#print s;
        | Some c ->
            let s = Printf.sprintf 
	      "Lancement de la simulation pour %d cycles.\n" c in 
            this#print_all s;
    end

  method quit_simulation circuit =
    begin
      let m = match circuit with 
        | Some c -> Printf.sprintf "Fin de la simulation (\"%s\").\n" c
        | None -> "Fin de la simulation.\n" 
      in
      this#print_all m;
      this#print_line_all
    end
    
  (* lecture de l'input_file *)
    
  method read_input_file name =
    begin
      this#print_line;
      let s = Printf.sprintf 
	"Lecture de l'Input_file (\"%s\").\n" name in 
      this#print s;
    end

  (* lecture de la net list *)

  method read_net_list name =
    begin
      this#print_line;
      let s = Printf.sprintf 
	"Lecture de la Net-list (\"%s\").\n" name in 
      this#print s;
    end

  method analyse_net_list =
    begin
      this#print "Analyse des fonctions de la net-list.\n"
    end

  method specialisation fichier line where name val_param val_args =
    begin
      let string_param =
	let short_list, cut =
	  match val_param with
	  | a::b::c::_::_ -> [a;b;c], true
	  | o -> o, false
	in
	match short_list with
	| [] -> ""
	| li -> string_of_list string_of_int ", " "[" (if cut then "...]" else "]") li
      and string_args =
	let short_list, cut = 
	  match val_args with
	  | a::b::c::_::_ -> [a;b;c], true
	  | o -> o, false
	in
	match short_list with
	| [] -> ""
	| li -> string_of_list (fun t -> t) ", " "[" (if cut then "...]" else "]") li
      in
      let mess = 
	Printf.sprintf "Spe -> \"%s%s%s\" (\"%s\", line %d, fct \"%s\")\n" name string_param string_args fichier line where
      in this#print mess 
    end

  method inline_functions =
    begin
      this#print_line;
      this#print "Construction du circuit :\n";
      this#print "Developpement de la hiérarchie (inline functions).\n"
    end

  method cds_brut =
    begin
      this#print "Construction du circuit brut.\n"
    end

  method cycle = 
    begin
      this#error;
      this#print "Le simulateur a detecté un cycle dans le circuit.\n";
      this#quit;
    end

  method cds_final taille transistors = 
    begin
      let m = Printf.sprintf "Circuit final : %d portes logiques primitives.\n"
	taille in
      let m2 = Printf.sprintf "Realisable avec %d transistors.\n"
	transistors in
      this#print (m^m2)
    end

  method tri_topo =
    begin
      this#print "Tri topologique du circuit (evaluation sequentielle).\n"
    end

  method creation_objet =
    begin
      this#print "Creation de l'objet-circuit\n"
    end
 
  method bpi_file_introuvable name =
    begin
      this#error;
      let s = Printf.sprintf 
	"Fichier BPI-file \"%s\" introuvable\n" name in 
      this#print s;
      this#quit
    end

  method bpo_file_introuvable name =
    begin
      this#error;
      let s = Printf.sprintf 
	"Fichier BPO-file \"%s\" introuvable\n" name in 
      this#print s;
      this#quit
    end

  method circuit_compile_introuvable name =
    begin
      this#error;
      let s = Printf.sprintf 
	"Fichier Circuit Compile \"%s\" introuvable\n" name in 
      this#print s;
      this#quit
    end

  method chargement_circuit_compile filename =
    begin
      let s = (Printf.sprintf "Chargement du circuit compilé (bpx) \"%s\"..." filename) in
      this#print s
    end

  method compilation_reussie net cible =
    begin
      let s = Printf.sprintf "Compilation de %s reussie --> \"%s\"\n" net cible in
      this#print_all s
    end

  method mauvais_format_circuit_compile name =
    begin
      this#error;
      let s = Printf.sprintf 
	"Le fichier \"%s\" n'a pas le format bpx\n" name in 
      this#print s;
      this#quit
    end

  method input_vide =
    begin
      this#error;
      this#print "L'entree est vide\n";
      this#quit
    end

  method counter_for_memory file = 
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\" : L'option counter n'est pas valide pour les ram et rom\n" file in
      this#print s;
      this#quit
    end

  method metafun_for_memory file = 
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\" : L'option metafun n'est pas valide pour les ram et rom\n" file in
      this#print s;
      this#quit
    end

  method rom_file_introuvable name =
    begin
      this#error;
      let s = Printf.sprintf 
	"Fichier ROM-file \"%s\" introuvable\n" name in 
      this#print s;
      this#quit
    end

 method rom_definition_trop_lg name attendu donne =
    begin
      this#error;
      let s1 = Printf.sprintf 
	"Fichier MEM-file, R(a|o)m \"%s\" mal specifiee :\n" name
      and s2 = Printf.sprintf 
	"Nombre de bits attendus : %d\nNombre de bits donnes   : %d\n"
      attendu donne in 
      this#print (s1^s2);
      this#quit
    end

 method new_rom_type name adresse sortie =
    begin
      let s = Printf.sprintf 
	"Definition de \'rom_%s\' (%d, %d) : " 
	name adresse sortie in 
      this#print s;
    end

 method new_ram_type name adresse sortie =
    begin
      let s = Printf.sprintf 
	"Definition de \'ram_%s\' (%d-%d-1-%d, %d) : " 
	name adresse adresse sortie sortie in 
      this#print s;
    end

 method lecture_etat_memoire len_donnee len_attendue =
   begin
     let s = Printf.sprintf 
       "( %d / %d ) bits specifies\n" len_donnee len_attendue in 
     this#print s; 
   end

 method new_ram_type_sans_init name adresse sortie =
    begin
      let s = Printf.sprintf 
	"Definition de \'ram_%s\' (%d-%d-1-%d, %d) : init false\n" 
	name adresse adresse sortie sortie in 
      this#print s;
    end

 method net_list_introuvable file link =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module %s (\"%s\") introuvable\n" file link in 
      this#print s;
      this#quit
    end
      
 method syntax_error name ligne =
   begin
     this#error;
     let s = Printf.sprintf 
       "Fichier \"%s\" ligne %d : Erreur de syntaxe\n" 
       name ligne in 
     this#print s;
     this#quit
   end
     
 method commande_syntax_error file ligne com =
   begin
     this#error;
     let s = Printf.sprintf 
       "Module \"%s\", ligne %d : Erreur de syntaxe : %s\n" file ligne com in 
     this#print s;
     this#quit
   end

 method string_arg_syntax_error file ligne arg =
   begin
     this#error;
     let s = Printf.sprintf 
       "Module \"%s\", ligne %d : Erreur de syntaxe : %s\n" file ligne arg in 
     this#print s;
     this#quit
   end

 method commande_syntax_error_external file bloc_name ligne com =
   begin
     this#error;
     let s = Printf.sprintf 
       "Module \"%s\", ligne %d, bloc externe \"%s\" :\n Erreur de syntaxe : \"%s\"\n" file ligne bloc_name com in 
     this#print s;
     this#quit
   end
  


 method macro_syntax_error file line macro com =
   begin
     this#error;
     let s = Printf.sprintf 
       "Module \"%s\", ligne %d, Erreur de syntaxe macro \"%s\" : %s\n" 
       file line macro com in 
     this#print s;
     this#quit  
   end
     
 method syntax_error_message m file ligne =
   begin
     this#error;
     let s = Printf.sprintf 
       "Fichier \"%s\" ligne %d : Erreur de syntaxe : %s\n" 
       file ligne m in 
     this#print s;
     this#quit
   end   

 method entree_invariante_memory name index =
    begin
      this#warning;
      let s = Printf.sprintf 
	"Design : Des entrees d'une R(a|o)m de type \"%s\" sont invariantes\n[!] inputs : %s\n" name index in
      this#print_all s
    end 
      
 method unused_some_output_memory name index =
   begin
     this#warning;
     let s = Printf.sprintf 
       "Design : Des sorties d'une R(a|o)m de type \"%s\" sont inutilisees\n[!] outputs : %s\n" name index in
     this#print_all s
   end 
     
 method unused_all_output_memory name =
    begin
      this#warning;
      let s = Printf.sprintf 
	"Design : Les sorties d'une R(a|o)m de type \"%s\" sont inutilisees\n[!] opt : remove this memory\n" name in
      this#print_all s
    end
     
  method variable_inutile file fct x =
    begin
      this#warning;
      let s = Printf.sprintf 
	"Module \"%s\", fonction \"%s\" : variable %s inutilisee\n" file fct x in
      this#print_all s
    end 

  method variable_inutile_utilisee file fct x =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", fonction \"%s\" : variable %s declaree unused mais utilisee\n" file fct x in
      this#print s;
      this#quit
    end     

  method fonction_inutile file fct =
    begin
      this#warning;
      let s = Printf.sprintf 
	"Module \"%s\" : Fonction \"%s\" inutilisee\n" file fct in
      this#print_all s
    end 

  method external_inutile file bloc =
    begin
      this#warning;
      let s = Printf.sprintf 
	"Module \"%s\" : Bloc external \"%s\" inutilise\n" file bloc in
      this#print_all s
    end 
  
  method entree_non_declaree file line ent =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d : Entree \"%s\" non declaree\n" file line ent in
      this#print s;
      this#quit
    end 

  method entree_type_error file line ent =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", igne %d : Entree \"%s\" indexation interdite.\n" file line ent in
      this#print s;
      this#quit
    end 
  
  method variable_non_assignee file fct x =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", fonction \"%s\" : le signal %s doit etre assigne\n" 
	file fct x in
      this#print s;
      this#quit
    end 

  (* boucles for *)
      
  method free_meta_var fic ligne var = 
    begin
      this#error;
      let s = Printf.sprintf
	"Module \"%s\", ligne %d : meta variable %s non liee\n" fic ligne var in
      this#print s;
      this#quit
    end

  method free_meta_var_macro fic line macro var = 
    begin
      this#error;
      let s = Printf.sprintf
	"Module \"%s\", ligne %d, definition-Macro \"%s\" :\n  [!] meta variable %s non liee\n" fic line macro var in
      this#print s;
      this#quit
    end
      
  method free_meta_var_external file bloc line var = 
    begin
      this#error;
      let s = Printf.sprintf
	"Module \"%s\", ligne %d, definition-external \"%s\" : meta variable %s non liee\n" file line bloc var in
      this#print s;
      this#quit
    end

  method type_clash fic ligne message = 
    begin
      this#error;
      let s = Printf.sprintf
	"Module \"%s\", ligne %d, Type Clash :\n\"%s\"\n" fic ligne message in
      this#print s;
      this#quit
    end
      
  method type_clash_macro fic line macro message = 
    begin
      this#error;
      let s = Printf.sprintf
	"Module \"%s\", ligne %d, definition-Macro \"%s\", Type Clash :\n\"%s\"\n" fic line macro message in
      this#print s;
      this#quit
    end
      
      
  method type_clash_external fic line bloc message = 
    begin
      this#error;
      let s = Printf.sprintf
	"Module \"%s\", ligne %d, definition-external \"%s\", Type Clash :\n\"%s\"\n" fic line bloc message in
      this#print s;
      this#quit
    end
      

  method remove_for_incomplet file ligne var = 
    begin
      this#error;
      let s = Printf.sprintf
	"Module \"%s\", ligne %d, variable de boucle %s non traitee\n" file ligne var in
      this#print s;
      this#quit
    end

  method remove_parametres_incomplet file line = 
    begin
      this#error;
      let s = Printf.sprintf
	"Le simulateur a rencontre un probleme, et doit quitter (bogue)\nModule \"%s\", ligne %d, REMOVE parametres incomplet\n" file line in
      this#print s;
      this#quit
    end    
      
  method double_utilisation_indice file ligne i =
    begin
      this#error;
      let s = Printf.sprintf
	"Module \"%s\", ligne %d : double utilisation de la variable de boucle %s\n" file ligne i in
      this#print s;
      this#quit
    end

  method capture_indice file ligne i =
    begin
      (* this#warning; *)
      let s = Printf.sprintf
	"[!] Module \"%s\", ligne %d : capture de la valeur precedente de %s\n" file ligne i in
      this#print s;
    end
      
  method entree_non_specifiee filename ent =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\" : L'entree \"%s\" n'est pas specifiee\n" 
	filename ent in
      this#print s;
      this#quit
    end 

  method entree_modifiee file fct x =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\". Dans la fonction \"%s\" : l'entree %s ne doit pas etre modifiee\n" 
	file fct x in
      this#print s;
      this#quit
    end 

  method branchement_multiple file name x = 
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", dans la fonction \"%s\" : branchements conflictuels de %s\n" 
	file name x in
      this#print s;
      this#quit
    end 

  method utilisation_any file line fct = 
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d : vous ne pouvez pas utiliser \"%s\" comme nom de fonction, d'entree ou de sortie (mot reserve au variable muette unused)\n" 
        file line fct in
      this#print s;
      this#quit
    end

  method multi_utilisation_var file line var =
    begin
      this#error;
      let s = Printf.sprintf
	"Module \"%s\", ligne %d : multi-utilisation de la variable %s\n"
	file line var in
      this#print s;
      this#quit
    end

  method parametre_deja_lie file line fct var =
    begin
      this#error;
      let s = Printf.sprintf
	"Module \"%s\", ligne %d : Dans la fonction %s, le parametre %s est deja lie.\n"
	file line fct var in
      this#print s;
      this#quit
    end   

  method definition_multiple_net file line fct =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\". Jusqu'a la ligne %d, definition multiple de la fonction \"%s\".\n" 
	file line fct in
      this#print s;
      this#quit
    end 

  method definition_multiple_parameter_net file line fct =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\". Jusqu'a la ligne %d, definition multiple de la fonction parametree \"%s\".\n" 
	file line fct in
      this#print s;
      this#quit
    end 

  method definition_multiple_bpo_method file line meth =
    begin
      this#error;
      let s = Printf.sprintf 
	"Fichier \"%s\". Jusqu'a la ligne %d, definition multiple de la methode \"%s\".\n" 
	file line meth in
      this#print s;
      this#quit
    end 

  method definition_multiple_rom file line name =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", igne %d : definition multiple de la ROM \"%s\".\n" file line name in
      this#print s;
      this#quit
    end 

  method definition_multiple_ram file line name =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d, definition multiple de la RAM \"%s\".\n" file line name in
      this#print s;
      this#quit
    end 

  method definition_multiple_input file line ent =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d : Specification multiple de l'entree \"%s\".\n" 
	file line ent in
      this#print s;
      this#quit
    end 

  method definition_multiple_macro fic line ent =
    begin
      this#error;
      let s = Printf.sprintf 
	"%s. Jusqu'a la ligne %d : definition multiple de la meta variable \"%s\".\n" 
	fic line ent in
      this#print s;
      this#quit
    end 

  method capture_macro file line mac =
    begin
      this#warning;
      let s = Printf.sprintf
	"Module \"%s\", avant la ligne %d : \n Capture de la valeur precedente de %s (environnement a pile)\n" file line mac in
      this#print_all s;
    end 

  method not_ocaml_var fic v =
    begin
      this#error;
      let s = Printf.sprintf 
	"\"%s\". Interface bebop-ocaml incorrecte\nVariable \"%s\" (syntax error en ocaml)\n" 
	fic v in
      this#print s;
      this#quit
    end 

  method definition_multiple_ocaml_var fic methode v =
    begin
      this#error;
      let s = Printf.sprintf 
	"\"%s\" : Interface bebop-ocaml methode \"%s\"\nDefinition multiple de la variable \"%s\"\n" 
	fic methode v in
      this#print s;
      this#quit
    end

  method definition_multiple_macro_input line ent =
    begin
      this#error;
      let s = Printf.sprintf 
	"Input-file. Ligne %d, definition multiple de la meta variable \"%s\".\n" 
	line ent in
      this#print s;
      this#quit
    end  

  method redefinition_prim file line fct =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d : \"%s\" est une primitive, elle ne peut etre redefinie.\n" 
	file line fct in
      this#print s;
      this#quit
    end 

  method arite_entree_prim file line fct prim n =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d, fonction \"%s\" : la primitive %s est a %d entree(s)\n" file line fct prim n in
      this#print s;
      this#quit
    end 

  method arite_sortie_prim file line fct prim n =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d, fonction \"%s\" :\n la primitive %s est a %d sortie(s)\n" file line fct prim n in
      this#print s;
      this#quit
    end 

  method arite_entree_fct file line fct prim n =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d, fonction \"%s\" :\n la fonction %s est a %d entree(s)\n" file line fct prim n in
      this#print s;
      this#quit
    end 

  method arite_sortie_fct file line fct prim n =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d, fonction \"%s\" : la fonction %s est a %d sortie(s)\n" file line fct prim n in
      this#print s;
      this#quit
    end 

  method arite_parametres_fct file line fct n =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d : \n [!] la fonction %s est a %d parametres\n" file line fct n in
      this#print s;
      this#quit
    end    

  method arite_args_fct file line fct n =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d : \n [!] la fonction %s est a %d arguments fonctionnels\n" file line fct n in
      this#print s;
      this#quit
    end    

  method fct_non_declaree file line fct name =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d, fonction \"%s\" :\n la fonction %s n'est pas declaree\n" file line fct name in
      this#print s;
      this#quit
    end 

  method fct_parametree_non_declaree file line fct name =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d, fonction \"%s\" :\n aucune fonction parametree %s n'a ete declaree\n" file line fct name in
      this#print s;
      this#quit
    end    

  method imb_non_declaree file line name =
    begin
      this#error;
      let s = Printf.sprintf 
	"Module \"%s\", ligne %d, dans l'appel imbrique :\n la fonction %s n'est pas declaree\n" file line name in
      this#print s;
      this#quit
    end 
      
  method circuit_vide =
    begin
      this#error;
      this#print 
	(Printf.sprintf "%s. La net_list doit comporter au moins 1 declaration de fonction\n" net_list);
      this#quit
    end 
 
  (* probleme d'implementation *)

  method memory_length_conflict =
    begin
      this#error;
      this#print "Conflit dans la taille memoire.(set_memory)\n";
      this#quit
    end
      
  method todo des =
    begin
      this#error;
      let s = Printf.sprintf "Partie non implementee : %s\n" des in
      this#print s;
      this#quit
    end
end
(* ===================================================================== *)

(* ===================================================================== *)
(** Objet de traitement de tous les messages *)
(* ===================================================================== *)
let message = new c_message
(* ===================================================================== *)
  
